








#####
# Packages
#####

library(stringr) #version 0.6.2
library(mlogit)  #version 0.2-4
library(mclogit) #version 0.3-1
library(foreign) #version 0.8-63
library(readODS) #version 1.4

#####
# Read data
#####

dat <- read.csv("dat_psrm.csv")

#####
# Recoding variables
#####

# Vote recommendation
dat$recommendation <- apply(dat[, grep("diff", colnames(dat))], 1, which.min)
dat$recommendation[dat$recommendation == 1] <- "CDU/CSU"
dat$recommendation[dat$recommendation == 2] <- "SPD"
dat$recommendation[dat$recommendation == 3] <- "FDP"
dat$recommendation[dat$recommendation == 4] <- "Gruene"
dat$recommendation[dat$recommendation == 5] <- "Linke"

# Discard cases where candidates are missing
dat <- dat[complete.cases(dat[, grep("diff", colnames(dat))]),]

# Difference between vote recommendation and prospective vote choice
dat$differs <- dat$recommendation != dat$erststimme

# Turn data into long format
dat.long <- mlogit.data(dat, choice = "erststimme", shape = "wide")

# Binary vote recommendation
dat.long$recommendation.bin <- dat.long$recommendation == dat.long$alt

# Distance to party
dat.long$diff <- as.numeric(rbind(
    dat$diff.cdu, 
    dat$diff.fdp, 
    dat$diff.gruene, 
    dat$diff.linke, 
    dat$diff.spd
))

# Party feeling thermometer
dat.long$thermo <- as.numeric(rbind(
    dat$cdu,
    dat$fdp, 
    dat$gruene, 
    dat$linke, 
    dat$spd
))

# Discard districts with fewer than 50 respondents
unique_users <- function(x){length(unique(x))}
user_count <- aggregate(dat.long$user_key, by = list(dat.long$wknr), unique_users)
user_count <- user_count[user_count$x > 50,]
dat.long <- dat.long[dat.long$wknr %in% user_count$Group.1,]

# Sort data by district
dat.long <- dat.long[order(dat.long$wknr),]

# Turn variables into factors for estimation
dat.long$candidate <- as.factor(str_c(dat.long$wahlkreis, dat.long$alt))
dat.long$party <- as.factor(dat.long$alt)

#####
# Valence models
#####

out.fixed <- mclogit(cbind(erststimme, wahlkreis) ~ diff + party, random = ~1|candidate, data = dat.long)
out.fixed.thermo <- mclogit(cbind(erststimme, wahlkreis) ~ diff + thermo + party, random = ~1|candidate, data = dat.long)
out.bin.fixed <- mclogit(cbind(erststimme, wahlkreis) ~ recommendation.bin + party, random = ~1|candidate, data = dat.long)
out.bin.fixed.thermo <- mclogit(cbind(erststimme, wahlkreis) ~ recommendation.bin + thermo + party, random = ~1|candidate, data = dat.long)

# Create data frame of results
valence <- data.frame(
    candidate = unique(dat.long$candidate), 
    valence.fixed = out.fixed$random.effects$candidate,
    valence.fixed.thermo = out.fixed.thermo$random.effects$candidate,
    valence.bin.fixed = out.bin.fixed$random.effects$candidate,
    valence.bin.fixed.thermo = out.bin.fixed.thermo$random.effects$candidate
)

# Add party and district numbers
valence$party <- rep(
    c("CDUCSU", "FDP", "GRÜNE", "DIE LINKE","SPD"), 
    length(out.fixed$random.effects$candidate)/5
)
valence$wknr <- rep(unique(dat.long$wknr), each = 5)

#####
# Additional variables
#####

# General candidacy
candidates <- read.csv("candidate_info_psrm.csv", stringsAsFactors = F)

# Rename colnames in candidates
colnames(candidates)[colnames(candidates) == "partei"] <- "party"

# Merge valence and candidate info
candidates <- merge(candidates, valence, by = c("wknr", "party"))

# Doctorate
candidates$doctorate <- str_detect(candidates$name, "Dr\\.")

# Job prestige
prestige <- read.ods("Berufsprestige.ods", sheet = 1)
colnames(prestige) <- prestige[1,]
colnames(prestige) <- tolower(colnames(prestige))
prestige <- prestige[-1,]
prestige[,3] <- as.numeric(prestige[,3])
prestige$code_voll <- str_replace(prestige$code_voll, ".$", "")
prestige <- aggregate(prestige$mps, by = list(prestige$code_voll), mean)
prestige[,1] <- as.numeric(prestige[,1])
colnames(prestige)[2] <- "mps"

# Coded candidate jobs
jobs <- read.csv("btw2013bewerb_Wohnort_oStr.csv", fileEncoding = "latin1", sep = ";", stringsAsFactors = F)
colnames(jobs) <- tolower(colnames(jobs))

# Merge candidate jobs and prestige
jobs <- merge(jobs, prestige, all.x = T, by.x = "berufsschlüssel", by.y = "Group.1")
jobs$partei[jobs$partei == "CDU" | jobs$partei == "CSU"] <- "CDUCSU"
colnames(jobs)[str_detect(colnames(jobs), "wahlkreis")] <- "wknr"
colnames(jobs)[colnames(jobs) == "partei"] <- "party"

candidates <- merge(candidates, jobs, all.x = T, by = c("wknr", "party"))

######
# Models: Explaining valence
######

mod.1 <- lm(valence.fixed ~
                district_incumbent +
                office +
                party,
            data = candidates,
            x = T
)

mod.2 <- lm(valence.fixed ~
                district_incumbent +
                log_campaign_events +
                log_poster +
                party,
            data = candidates,
            x = T
)

mod.3 <- lm(valence.fixed ~
                doctorate +
                mps +
                att06 +
                party,
            data = candidates,
            x = T
)

#####
# Table 1
#####

summary(out.fixed)

#####
# Table 2
#####

summary(mod.1)
summary(mod.2)
summary(mod.3)

#####
# Table 3
#####

summary(out.fixed)
summary(out.fixed.thermo)

#####
# Table 4
#####

summary(out.bin.fixed)
summary(out.bin.fixed.thermo)

#####
# Figure 1
#####

# Top four candidates for figure 1
top_4_hi <- candidates[order(candidates$valence.fixed, decreasing = T), c("name", "party", "valence.fixed")][1:4,]
top_4_hi$party[top_4_hi$party == "DIE LINKE"] <- "LINKE"
top_4_lo <- candidates[order(candidates$valence.fixed), c("name", "party", "valence.fixed")][1:4,]
top_4_lo$party[top_4_hi$party == "CDUCSU"] <- "CDU/CSU"

pdf("figure_1.pdf")
plot(
    density(candidates$valence.fixed), 
    bty = "n",
    xlab = "Estimated candidate valence",
    main = "",
    xlim = c(-1.5,1.5)
)
legend(
    "topright", 
    legend = 
        str_c(
            str_extract(top_4_hi$name, "[[:alpha:]]+$"),
            " (",
            top_4_hi$party,
            ") +",
            round(top_4_hi$valence.fixed, 2)
        ),
    bty = "n"
)
legend(
    "topleft", 
    legend = 
        str_c(
            str_extract(top_4_lo$name, "[[:alpha:]]+$"),
            " (",
            top_4_lo$party,
            ") ",
            round(top_4_lo$valence.fixed, 2)
        ),
    bty = "n"
)
dev.off()

######
# Figure 2
######

pdf("figure_2_panel_1.pdf")
plot(
    candidates$valence.fixed, 
    candidates$valence.fixed.thermo, 
    xlab = "Candidate valence (Distance)", 
    ylab = "Candidate valence (Distance and party feeling thermometer)", 
    bty = "n"
)
dev.off()

pdf("figure_2_panel_2.pdf")
plot(
    candidates$valence.fixed, 
    candidates$valence.bin.fixed, 
    xlab = "Candidate valence (Distance)", 
    ylab = "Candidate valence (Vote recommendation)", 
    bty = "n"
)
dev.off()

pdf("figure_2_panel_3.pdf")
plot(
    candidates$valence.fixed, 
    candidates$valence.bin.fixed.thermo, 
    xlab = "Candidate valence (Distance)", 
    ylab = "Candidate valence (Vote recommendation and party feeling thermometer)", 
    bty = "n"
)
dev.off()

pdf("figure_2_panel_4.pdf")
plot(
    candidates$valence.fixed.thermo, 
    candidates$valence.bin.fixed, 
    xlab = "Candidate valence (Distance and feeling thermometer)", 
    ylab = "Candidate valence (Vote recommendation)", 
    bty = "n"
)
dev.off()

pdf("figure_2_panel_5.pdf")
plot(
    candidates$valence.fixed.thermo, 
    candidates$valence.bin.fixed.thermo, 
    xlab = "Candidate valence (Distance and feeling thermometer)", 
    ylab = "Candidate valence (Vote recommendation and feeling thermometer)", 
    bty = "n"
)
dev.off()

pdf("figure_2_panel_6.pdf")
plot(
    candidates$valence.bin.fixed, 
    candidates$valence.bin.fixed.thermo, 
    xlab = "Candidate valence (Vote recommendation)", 
    ylab = "Candidate valence (Vote recommendation and feeling thermometer)", 
    bty = "n"
)
dev.off()

